home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 095 / rfix0620.arc / R-PC0620.MRG < prev    next >
Encoding:
Text File  |  1988-06-20  |  16.6 KB  |  417 lines
  1. * ------------[ BLED merge (c) Ken Goosens ]-------------
  2. * Merge this against I:\161A.REL\RBBS-PC.BAS to produce RBBS-PC.BAS
  3. * I:\161A.REL\RBBS-PC.BAS:  Date 3-25-1988  Size 213760 bytes
  4. * ------------[ Created 06-20-1988 22:31:14 ]------------
  5. * REPLACING old line(s) by new
  6. * ------[ first line different ]------
  7. 105 VERSION.ID$ = "CPC16.1A with fixes through 06-20-88"             ' TF062001
  8.     XOFF$ = CHR$(19)
  9.     XON$ = CHR$(17)
  10.     INTERRUPT.ON$ = CHR$(11) + CANCEL$ + XOFF$ + XON$ + CARRIAGE.RETURN$
  11.   ' ******************** Logon Error Message Table ****************************
  12. * REPLACING old line(s) by new
  13. 150 IF SUB.BOARD THEN _
  14.        GOSUB 12987 : _
  15.        GOSUB 5135 : _
  16.        GOTO 165
  17.     SYSOP.AVAILABLE = VAL(MID$(MESSAGE.RECORD$,32,2))
  18.     SYSOP.ANNOY = VAL(MID$(MESSAGE.RECORD$,34,2))
  19.     SYSOP.NEXT = VAL(MID$(MESSAGE.RECORD$,36,2))
  20.     PRINTER = VAL(MID$(MESSAGE.RECORD$,38,2))
  21.     IF TURN.PRINTER.OFF THEN _
  22.        PRINTER = FALSE
  23.     EXIT.TO.DOORS = VAL(MID$(MESSAGE.RECORD$,40,2))
  24.     EIGHT.BIT = VAL(MID$(MESSAGE.RECORD$,42,2))
  25.     BPS = VAL(MID$(MESSAGE.RECORD$,44,2))
  26.     SNOOP = VAL(MID$(MESSAGE.RECORD$,58,2))
  27.     MID$(MESSAGE.RECORD$,57,1) = "I"
  28.     PRIVATE.DOOR = VAL(MID$(MESSAGE.RECORD$,72,2))
  29.     MID$(MESSAGE.RECORD$,72,2) = STR$(FALSE)
  30. * ------[ first line different ]------
  31.     LOCAL.USER = VAL(MID$(MESSAGE.RECORD$,101,2))                    ' TF033101
  32.     IF EXIT.TO.DOORS OR PRIVATE.DOOR THEN _
  33.        TURBO.LOGON = TRUE
  34.     PUT 1,NODE.RECORD.INDEX
  35.     GOSUB 12985
  36. '
  37. ' *****************************************************************************
  38. ' *  TEST FOR MULTI LINK PRESENT IF NOT COMPAQ COMPUTER                       *
  39. ' *****************************************************************************
  40. '
  41. * REPLACING old line(s) by new
  42. 175 GOSUB 5344
  43.     IF DIR.CATEGORY.FILE$ <> PREV.DIRCAT$ THEN _
  44.        PREV.DIRCAT$ = DIR.CATEGORY.FILE$ : _
  45.        CALL CTLINES (MAX.ENTRIES) : _
  46.        REDIM CATEGORY.NAME$(MAX.ENTRIES),CATEGORY.CODE$(MAX.ENTRIES),_
  47.              CATEGORY.DESC$(MAX.ENTRIES) : _
  48.        CALL INITFMS (CATEGORY.NAME$(),CATEGORY.CODE$(), _
  49.                      CATEGORY.DESC$(),NUM.CATEGORIES)
  50.     LOCAL.USER.MODE = (RIGHT$(COM.PORT$,1) < "1")
  51.     REMOTE.ECHO = (DEFAULT.ECHOER$ = "R" AND NOT LOCAL.USER.MODE)
  52.     CALL BRKFNAME (CALLERS.FILE$,DRV$,X$,Y$,TRUE)
  53.     NODE.WORK.FILE$ = DRV$ + _
  54.                       "NODE" + _
  55.                       NODE.ID$ + _
  56.                       "WRK.BAT"
  57.     SECONDS.PER.SESSION! = MINUTES.PER.SESSION! * 60
  58.     IF NOT LOCAL.USER.MODE THEN _
  59. * ------[ first line different ]------
  60.        IF NOT EXIT.TO.DOORS THEN _                                   ' TF033101
  61.           GOTO 180 _                                                 ' TF033101
  62.        ELSE IF NOT LOCAL.USER THEN _                                 ' TF033101
  63.                GOTO 180                                              ' TF033101
  64.     LOCAL.USER = TRUE
  65.     BPS = -7
  66.     BAUD.TEST = 19200
  67.     EIGHT.BIT = TRUE
  68.     SNOOP = TRUE
  69.     RECYCLE.TO.DOS = TRUE
  70.     IF EXIT.TO.DOORS THEN _
  71.        CALL AMORPM : _
  72.        CALL READPROF : _
  73.        GOTO 410
  74.     GOSUB 178
  75.     GOTO 345
  76. * REPLACING old line(s) by new
  77. 821 CALL TRIM (CI$)
  78.     IF PRIVATE.DOOR AND _
  79.        TRANSFER.FUNCTION = 3 THEN _
  80.        TRANSFER.FUNCTION = 0 : _
  81.        GOTO 832
  82.     IF REGISTRATION.PROGRAM$ = "NONE" OR _
  83.        REGISTRATION.PROGRAM$ = "" THEN _
  84.        GOTO 832
  85. * ------[ first line different ]------
  86.     B$ = REGISTRATION.PROGRAM$                                       ' TF033105
  87.     TRANSFER.FUNCTION = 3                                            ' TF033105
  88.     CALL XFRETURN
  89. '
  90. ' *****************************************************************************
  91. ' *  ESC PRESSED ON LOCAL CONSOLE ENTERS HERE                                 *
  92. ' *****************************************************************************
  93. '
  94. * REPLACING old line(s) by new
  95. 822 LOCATE 24,1
  96.     CALL FINDTIME (USER.LOGON.TIME!)
  97.     CALL MODEMPUT (MODEM.GO.OFFHOOK.COMMAND$)
  98.     LOCAL.USER = TRUE
  99. * ------[ first line different ]------
  100.     SNOOP = TRUE                                                     ' TF033103
  101.     WAIT.BEFORE.DISCONNECT = 32400
  102.     BPS = -7
  103.     CALL MUZAK (2)
  104.     IF LOCAL.PASSWORD$ = "NONE" THEN _
  105.        GOTO 828
  106.     D$ = "Enter PASSWORD (dots echo) "
  107.     GOSUB 1310
  108.     Z$ = ""
  109.     INKEYS.PRESSED = 0
  110. * REPLACING old line(s) by new
  111. 836 IF LOCAL.USER THEN _
  112. * ------[ first line different ]------
  113.        TALK.TO.MODEM.AT$ = "19200" : _                               ' TF033101
  114.        BAUD.PARITY$ = "19200 BAUD,N,8,1" : _                         ' TF033101
  115.        SNOOP = TRUE : _
  116.        LINE.FEEDS = TRUE : _
  117.        A = INSTR(TRANSFER.OPTIONS$,CARRIAGE.RETURN$) : _
  118.        IF A > 0 THEN _
  119.           MID$(TRANSFER.OPTIONS$,A,1) = " "
  120. * REPLACING old line(s) by new
  121. 1235 Z$ = B$(1)
  122.      IF LEN(Z$) < 1 THEN _
  123.         GOTO 1230
  124.      CALL ALLCAPS (Z$)
  125.      CALL SRCHCMND (SUB.SECTION,FF)
  126.      IF FF < 1 THEN _
  127. * ------[ first line different ]------
  128.         CALL QTPUT ("Unknown command <"+Z$+">",1) : _                ' TF041701
  129.         GOTO 1230
  130. * REPLACING old line(s) by new
  131. 1300 CALL QTPUT ("Message base " + GRN$,1)
  132.      RETURN
  133. * ------[ first line different ]------
  134. ' ***************************************************************************** ' TF041701
  135. ' * COMMON LOCAL DISPLAY PRINT                                                * ' TF041701
  136. ' ***************************************************************************** ' TF041701
  137. * DELETING old line(s)
  138. 1305
  139. * REPLACING old line(s) by new
  140. 1401 CALL SUBMENU ("Which questionnaire(s), L)ist" + PRESS.ENTER.EXPERT$, _
  141. * ------[ first line different ]------
  142.                    A1$,QUES.PATH$,".DEF","",USER.GRAPHIC.DEFAULT$,TRUE,FALSE,TRUE) ' TF062001
  143.      IF Q = 0 THEN _
  144.         RETURN
  145.      IF SUBROUTINE.PARAMETER = -1 THEN _
  146.         RETURN 10595
  147.      QUESTIONNAIRE.HOLD$ = Z$
  148.      GOSUB 11520
  149.      CLOSE 2
  150.      CALL UPDTCALR (QUESTIONNAIRE.HOLD$ + " questionnaire " + _
  151.         MID$("answeredaborted",1 - 8 * QUESTIONNAIRE.ABORTED,8),2)
  152.      ANS.INDEX = ANS.INDEX + 1
  153.      IF ANS.INDEX > LAST.INDEX THEN _
  154.         ANS.INDEX = 0
  155.      GOTO 1401
  156. '
  157. ' *****************************************************************************
  158. ' *             TOGGLE COMMAND (UTILITIES)                                    *
  159. ' *****************************************************************************
  160. '
  161. * REPLACING old line(s) by new
  162. 2020 IF REPLY THEN _
  163. * ------[ first line different ]------
  164.         FOUND = TRUE : _                                             ' TF041803
  165.         GOTO 2060
  166.      SUBJECT$ = ""
  167.      A$ = "To (Press [ENTER] for All)"
  168.      CALL SKIPLINE (1)
  169.      GOSUB 12995
  170.      IF LEN(B$) > 30 THEN _
  171.         A$ = "30 Char. Max" : _
  172.         GOSUB 12979 : _
  173.         GOTO 2020
  174. * REPLACING old line(s) by new
  175. 2620 A$ = "Line #" + _
  176.           STR$(L) + _
  177.           " is:" + _
  178.           RETURN.LINE.FEED$ + _
  179.           A$(L)
  180.      GOSUB 12977
  181.      IF NOT EXPERT.USER THEN _
  182.         CALL QTPUT ("Search & replace",1)
  183.      A$ = "Search for" + _
  184.           PRESS.ENTER.EXPERT$
  185. * ------[ first line different ]------
  186.      PARSE.OFF = TRUE                                                ' TF041802
  187.      GOSUB 12995
  188.      IF Q = 0 THEN _
  189.         GOTO 2300
  190.      X = INSTR(B$,";")                                               ' TF041802
  191.      IF X > 0 THEN _                                                 ' TF041802
  192.         X$ = LEFT$(B$,X-1) : _                                       ' TF041802
  193.         Y$ = RIGHT$(B$,LEN(B$)-X) : _                                ' TF041802
  194.         GOTO 2660                                                    ' TF041802
  195.      X$ = B$
  196.      A$ = "And replace by"
  197.      PARSE.OFF = TRUE                                                ' TF041802
  198.      GOSUB 12995
  199.      Y$ = B$
  200. * REPLACING old line(s) by new
  201. * ------[ first line different ]------
  202. 4371 IF MESSAGES.SELECTED.INDEX <= NUMBER.MESSAGES.SELECTED THEN _   ' TF041603
  203.         CALL CHECKINT (B$(MESSAGES.SELECTED.INDEX)) : _              ' TF041603
  204.         IF EC <> 0 THEN _                                            ' TF041603
  205.            EL = 4371 : _                                             ' TF041603
  206.            GOTO 13000 _                                              ' TF041603
  207.         ELSE CURRENT.MESSAGE = TESTED.INTEGER.VALUE : _              ' TF041603
  208.              GOTO 4415                                               ' TF041603
  209. * REPLACING old line(s) by new
  210. 4561   FF = INSTR(MID$(MESSAGE.RECORD$,X),LEFT$(ACTIVE.USER.NAME$,22))
  211.        IF FF > 0 THEN _
  212.           X = LEN(ACTIVE.USER.NAME$) + FF : _
  213.           IF (FF < 7 OR MID$(MESSAGE.RECORD$,FF - 1,1) = " ") AND (X > 58 OR MID$(MESSAGE.RECORD$,X,1) = " ") THEN _
  214.              UH = TRUE _
  215.           ELSE IF FF < 37 THEN _
  216.                   X = 37 : _
  217.                   GOTO 4561
  218. * ------[ first line different ]------
  219.        MSG.TO.CALLER = (UH AND (FF = 37)) OR _                       ' TF041203
  220.                        (MID$(MESSAGE.RECORD$,37,5) = "ALL  ")        ' TF041203
  221.        MSG.FROM.CALLER = UH AND (FF = 6)                             ' TF041203
  222. * REPLACING old line(s) by new
  223. 8050 MESSAGE.FROM$ = MID$(MESSAGE.RECORD$,6,31)
  224.      CALL TRIM (MESSAGE.FROM$)
  225.      IF LEN(MESSAGE.FROM$) < 23 THEN _
  226.         MESSAGE.FROM$ = MESSAGE.FROM$ + _
  227.                         SPACE$(23 - LEN(MESSAGE.FROM$))
  228.      A$ = "Msg # " + _
  229.           LEFT$(MESSAGE.RECORD$,5) + _
  230.           " Dated " + _
  231.           MID$(MESSAGE.RECORD$,68,8) + _
  232.           " " + _
  233.           MID$(MESSAGE.RECORD$,59,8)
  234.      IF USER.SECURITY.LEVEL >= SEC.CHANGE.MSG THEN _
  235.         A$ = A$ + _
  236.              "  Security:" + _
  237.              STR$(MESSAGE.SECURITY)
  238.      IF NOT RET THEN _
  239.         IF READ.MESSAGES THEN _
  240.            CALL QTPUT (A$,1): _
  241.            CALL QTPUT (" From: " + MESSAGE.FROM$,1) : _
  242.            CALL QTPUT ("   To: " + MESSAGE.TO$,1) : _
  243.            A$ = "   Re: " + _
  244.                 SUBJECT$ _
  245.         ELSE A$ = LEFT$(MESSAGE.RECORD$,5) + _
  246.                   " " + _
  247.                   MID$(MESSAGE.RECORD$,68,8) + _
  248.                   " " + _
  249.                   LEFT$(MESSAGE.TO$,19) + _
  250.                   " " + _
  251.                   LEFT$(MESSAGE.FROM$,18) + _
  252.                   " " + _
  253.                   LEFT$(SUBJECT$,24) : _
  254.              GOTO 8080
  255.      IF QUICK.SCAN.MESSAGES OR _
  256. * ------[ first line different ]------
  257.         SCAN.MESSAGES THEN _                                         ' TF041203
  258.            GOTO 8080                                                 ' TF041203
  259.      IF ((NOT SYSOP) AND NOT (MSG.FROM.CALLER)) THEN _               ' TF041203
  260.         GOTO 8077
  261. * REPLACING old line(s) by new
  262. 8076 IF MID$(MESSAGE.RECORD$,123,6) = STRING$(6,0) OR _
  263.         MID$(MESSAGE.RECORD$,123,6) = SPACE$(6) THEN _
  264. * ------[ first line different ]------
  265.            A$ = A$ + " -Not Received-" : _                           ' TF041203
  266.            GOTO 8077                                                 ' TF041203
  267.      YY$ = RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,126,1))),2) + _
  268.            ":" + _
  269.            RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,127,1))),2) + _
  270.            ":" + _
  271.            RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,128,1))),2)
  272.      FOR I = 1 TO 8
  273.         IF MID$(YY$,I,1) = " " THEN _
  274.            MID$(YY$,I,1) = "0"
  275.      NEXT
  276.      YY$ = YY$ + _
  277.            " on "
  278.      YY$ = YY$ + _
  279.            RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,123,1))),2) + _
  280.            "/" + _
  281.            RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,124,1))),2) + _
  282.            "/" + _
  283.            RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,125,1))),2)
  284.      FOR I = 13 TO 20
  285.         IF MID$(YY$,I,1) = " " THEN _
  286.            MID$(YY$,I,1) = "0"
  287.      NEXT
  288.      A$ = A$ + _
  289.           " Received " + _                                           ' TF041203
  290.           YY$
  291. * REPLACING old line(s) by new
  292. * ------[ first line different ]------
  293. 8077 IF MSG.FROM.CALLER OR (NOT MSG.TO.CALLER) THEN _                ' TF041203
  294.         GOTO 8080                                                    ' TF041203
  295.      YY$ = DATE$
  296.      WK$ = TIME$
  297.      MID$(MESSAGE.RECORD$,123,6) = CHR$(VAL(MID$(YY$,1,2))) + _
  298.                                    CHR$(VAL(MID$(YY$,4,2))) + _
  299.                                    CHR$(VAL(MID$(YY$,9,2))) + _
  300.                                    CHR$(VAL(MID$(WK$,1,2))) + _
  301.                                    CHR$(VAL(MID$(WK$,4,2))) + _
  302.                                    CHR$(VAL(MID$(WK$,7,2)))
  303.      GOSUB 12986
  304.      PUT 1,M(MESSAGE.DIM.INDEX,1)
  305.      GOSUB 12987
  306. * REPLACING old line(s) by new
  307. 11520 QUESTIONNAIRE.ABORTED = FALSE
  308.       CALL FINDIT (FILE.NAME$)
  309.       IF NOT OK THEN _
  310.          RETURN
  311.       REDIM A$(256)
  312.       CALL ASKUSERS
  313.       IF ADJUSTED.SECURITY THEN _
  314.          GOSUB 12989 : _
  315.          LSET SECURITY.LEVEL$ = MKI$(USER.SECURITY.LEVEL) : _
  316.          GOSUB 9440 : _
  317.          GOSUB 12991 : _
  318.          CALL CALLOPT : _
  319.          GOSUB 5135
  320.       REDIM A$(ADIM)
  321.       IF SUBROUTINE.PARAMETER = -1 THEN _
  322. * ------[ first line different ]------
  323.          RETURN 10595                                                ' TF041702
  324.       RETURN
  325. '
  326. ' *****************************************************************************
  327. ' *  A - COMMAND FROM 5- USER MAINTENANCE OPTIONS (ADD USER)                  *
  328. ' *****************************************************************************
  329. '
  330. * REPLACING old line(s) by new
  331. * ------[ first line different ]------
  332. 13000 IF DEBUG THEN _                                                ' TF033102
  333.          A$ = "RBBS-PC DEBUG Error Trap Entry ERL=" + _
  334.               STR$(EL) + _
  335.               " ERR=" + _
  336.               STR$(EC) : _
  337.               CALL PRINTIT(A$) : _
  338.               D$ = A$ : _
  339.               GOSUB 1315
  340.       IF EL = 1905 AND EC = 63 THEN _
  341.          CLOSE 1 : _
  342.          KILL ACTIVE.MESSAGE.FILE$ : _
  343.          GOTO 5350
  344.       IF EL = 4371 AND EC = 6 THEN _
  345.          GOTO 1200
  346.       IF EL =  4740 THEN _
  347.          GOTO 4745
  348.       IF EL =  5151 AND EC = 62 THEN _
  349.          CALL UPDTCALR (PASSWORDS.FILE$ + " bad format!",2) : _
  350.          GOTO 5160
  351.       IF EL =  7130 AND EC = 53 THEN _
  352.          GOTO 7260
  353.       IF EL = 20242 AND EC = 62 THEN _
  354.          CALL UPDTCALR (FILESEC.FILE$ + " bad format!",2) : _
  355.          GOTO 20247
  356.       IF EL = 20262 THEN _
  357.          A$ = "<Download aborted>" : _
  358.          DOWNLOAD.COMPLETED = FALSE : _
  359.          GOTO 20390
  360.       IF EL = 20452 AND EC = 53 THEN _
  361.          GOTO 20451
  362.       IF EL = 20560 AND EC = 67 THEN _
  363.          GOTO 20451
  364.       IF EL = 20560 AND EC = 70 THEN _
  365.          IF VAL(FREE.SPACE$) > 1999 THEN _
  366.             GOTO 20610 _
  367.          ELSE CALL QTPUT ("No room for uploads. Try tomorrow.",1) : _
  368.               GOTO 5160
  369.       IF EL = 20620 THEN _
  370.          GOTO 20670
  371.       IF EL = 20650 THEN _
  372.          GOTO 20670
  373.       IF EL = 20736 AND EC = 53 THEN _
  374.          GOTO 5160
  375.       IF EL = 20900 AND EC = 75 THEN _
  376.          GOTO 21230
  377.       IF EL = 20900 AND EC = 70 THEN _
  378.          CALL QTPUT ("No room for uploads. Try tomorrow.",1) : _
  379.          GOTO 21230
  380.       IF EL = 21131 THEN _
  381.          EC = 0 : _
  382.          GOTO 21230
  383.       IF EL = 21480 THEN _
  384.          CALL LOGERROR : _
  385.          IF EC = 57 THEN _
  386.             CALL QTPUT("Error reading file.  Aborting download",1) : _
  387.             DOWNLOAD.COMPLETED = FALSE : _
  388.             GOTO 21230
  389. * REPLACING old line(s) by new
  390. 23000 GET 1,1
  391.       HIGH.MESSAGE.NUMBER = VAL(LEFT$(MESSAGE.RECORD$,8))
  392.       AUTO.ADD.SECURITY   = CVI(MID$(MESSAGE.RECORD$,9,2))
  393.       CALLS.TODATE! = VAL(MID$(MESSAGE.RECORD$,11,10))
  394.       CURRENT.USER.COUNT = VAL(MID$(MESSAGE.RECORD$,57,5))
  395. * ------[ first line different ]------
  396. '     HIGHEST.USER.RECORD = VAL(MID$(MESSAGE.RECORD$,62,5))          ' TF042101
  397.       FIRST.MESSAGE.RECORD = VAL(MID$(MESSAGE.RECORD$,68,7))
  398.       NEXT.MESSAGE.RECORD = VAL(MID$(MESSAGE.RECORD$,75,7))
  399.       HIGHEST.MESSAGE.RECORD = VAL(MID$(MESSAGE.RECORD$,82,7))
  400.       NODES.IN.SYSTEM = VAL(MID$(MESSAGE.RECORD$,127))
  401.       IF LOCAL.USER.MODE AND NOT SYSOP THEN _
  402.          RETURN
  403.       IF NOT SYSOP AND NOT LOCAL.USER THEN _
  404.          RETURN
  405.       IF TEMP.SYSOP THEN _
  406.          RETURN
  407.       IF LAST.MESSAGE.READ < VAL(MID$(MESSAGE.RECORD$,123,4)) THEN _
  408.          LAST.MESSAGE.READ = VAL(MID$(MESSAGE.RECORD$,123,4))
  409.       LAST.MESSAGE.READ = - LAST.MESSAGE.READ * _
  410.                       (LAST.MESSAGE.READ <= HIGH.MESSAGE.NUMBER)
  411.       RETURN
  412. '
  413. ' *****************************************************************************
  414. ' *  UPDATE MESSAGE HEADER RECORD DATA                                        *
  415. ' *****************************************************************************
  416. '
  417.